Maternal mortality is a human rights issue which affects childbearing women across the globe. Many maternal deaths are preventable; limited access to adequate health care, systemic racial and gender biases, and lack of legislative protections compound this social ill.
Currently, most efforts to combat maternal mortality focus on understanding the scope of pregnancy-related deaths (broadly defined as deaths which occur during the gestational period and up to a year post termination of pregnancy, resultant from pregnancy causes and complications). Research and program evaluation are important components to progressing this work, as well as crucial collaboration with on-the-ground storytelling directly from affected mothers, surviving family members, and social workers.
In 2000, the World Health Organization publicized its Millennium Development Goals. A highlighted goal was to reduce the maternal mortality ratio (“MMR”: number of deaths per 100,000 live births) by three-quarters over the next 15 years. In their follow-up report released in late 2015 (“WHO report”), they identified that prevention and reduction of maternal mortality requires rigorous, standardized data collection. Women who are at higher risk of maternal death, and of whom policy makers should be interested in intervening on, live in regions where data collection and accuracy regarding maternal health, morbidity and morality are not prioritized.
The WHO report identified a 44% decrease in global MMR. Disaggregating data further, they observed an annual average decrease in MMR of 2.4% in developing* world regions (*as defined in the Millennium Development Goal). An even greater rate of decline in MMR for women in Eastern Asian countries was reported as a 5% annual average decrease.
WHO_data <- read.csv("data/WHO_MMR-data-1990-2015 (1)/countryresults_all.csv")
# Get maternal mortality ratio point estimates:
mmr_data <- filter(WHO_data,
indicator == "mmr",
estimate == "point estimate",
rounded == "FALSE")
WorldBank_data <- read_excel("data/WB_country_region_income.xlsx")
WorldBank_data <- WorldBank_data[,-c(3,6,7)]
# Merge WHO and WB data:
merged_WHO_WB_data <- sqldf("SELECT * from mmr_data
LEFT OUTER join WorldBank_data
ON mmr_data.iso = WorldBank_data.Code")
merged_WHO_WB_data$Region[merged_WHO_WB_data$Region %in% c("North America", "Latin America & Caribbean")] <- "NA, LATAM & Caribbean"
# Group and summarize merged WHO and WB data into a new table based on world region:
region_data <- summarize(group_by(merged_WHO_WB_data, year, Region),
avg_mmr=round(mean(value, na.rm=TRUE), digits=0))
df <- region_data
ggplot(data = df, aes(x = year, y = avg_mmr, group = Region)) +
geom_line(aes(color = Region), size = 1.15) +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("Sub-Saharan Africa", "South Asia", "East Asia & Pacific")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = 25,
hjust = "left",
fontface = "bold",
size = 3,
family = "PT Mono") +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("East Asia & Pacific")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = 25,
hjust = "left",
fontface = "bold",
size = 3,
family = "PT Mono") +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("Europe & Central Asia")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = -25,
hjust = "left",
fontface = "bold",
size = 3,
family = "PT Mono") +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("NA, LATAM & Caribbean")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = 25,
fontface = "bold",
size = 3,
family = "PT Mono") +
geom_text(data = df %>% filter(year == 1995 & Region %in% c("Middle East & North Africa")),
aes(label = Region, color = Region),
nudge_x = 0.5,
nudge_y = -25,
fontface = "bold",
size = 3,
family = "PT Mono") +
scale_color_manual(values = rev(c("#7102FA", "#E48023", "#357797", "#948E00", "#13394A", "#CC149B"))) +
scale_x_continuous(breaks = seq(1985, 2015, 5)) +
labs(title = "Overall, maternal mortality ratios around the world have decreased in the last 30 years",
subtitle = "Average number of deaths per 100,000 live births by global region. Maternal mortality, however, remains\nhigh among childbearing women in Sub-Saharan African countries (482 deaths/100,000 live births).\nSouth Asian countries had a significant drop in maternal mortality, from 883 deaths to 179 deaths\nper 100,000 live births.",
caption = "Source(s): The World Health Organization / The World Bank") +
xlab("Year") +
ylab("Deaths per 100,000 live births") +
coord_cartesian(clip = "off") +
special_theme +
theme(legend.position = "none",
panel.grid.minor.x = element_blank()
)Another important evaluation metric of maternal mortality is total maternal deaths; which is necessary to provide a comprehensive review of effective intervention. Per the WHO report, total maternal deaths in Sub-Saharan African countries still remains high and unchanged over time. Other world regions decrease in total maternal deaths over time, and global trend shows a 43% decrease in annual maternal deaths. Overwhelmingly, 99% of the annual maternal deaths in 2015 occurred in developing regions. These measurements reveal the hard-hitting reality of what it means to survive as a woman in regions where there are ongoing political crises, continued environmental disasters, and low socioeconomic opportunity and mobility.
# read in World Health Organization and World Bank data:
WHO_data <- read.csv("data/WHO_MMR-data-1990-2015 (1)/countryresults_all.csv")
WorldBank_data <- read_excel("data/old data/world bank data.xlsx")
WorldBank_data <- WorldBank_data[-c(1),]
WorldBank_data <- WorldBank_data[,-c(1,2,5)]
# create a new table of maternal mortality ratio point estimates:
matdeath_data <- filter(WHO_data,
indicator == "matdeaths",
estimate == "point estimate",
rounded == "TRUE")
# merge WHO and WB data:
new_data <- sqldf("SELECT * from matdeath_data
LEFT OUTER join WorldBank_data
ON matdeath_data.iso = WorldBank_data.Code")
show_years <- c(2015, 2010, 2005, 2000, 1995, 1990, 1985)
new_data <- subset(new_data, year %in% show_years)
rollup_new_data <- new_data
rollup_new_data$Region[rollup_new_data$Region %in% c("North America", "Latin America & Caribbean")] <- "North Amer. & Latin Amer. & Caribbean"
# group and summarize into a new table:
sum_region_data <- summarize(group_by(rollup_new_data, year, Region),
total_matdeaths_region = round(sum(value, na.rm=TRUE),
digits=0))
sum_year_data <- summarize(group_by(sum_region_data, year),
total_matdeaths_year = sum(total_matdeaths_region,
na.rm=TRUE))
merge_data <- merge(sum_region_data, sum_year_data, by="year")
df <- merge_data
gridline_color <- "#8A8A8A"
background_color <- "#F7F7F7"
stackedbar_colors <- rev(c("#7102FA", "#E48023", "#357797", "#E3DD44", "#13394A", "#CC149B"))
geomtext_font <- "PT Mono"
ggplot(df, aes(x = year, y = total_matdeaths_region, fill = Region)) +
geom_bar(stat = "identity", alpha = 0.85) +
scale_fill_manual(values = stackedbar_colors) +
scale_x_continuous(breaks = seq(1985, 2015, 5)) +
scale_y_continuous(labels = scales::comma) +
geom_text(aes(y = total_matdeaths_year, label = total_matdeaths_year),
size = 5,
vjust = -.7,
colour = "black",
family = geomtext_font,
face = "bold") +
labs(title = "Total number of maternal deaths decrease in all world regions except in\nSub-Saharan African countries",
subtitle = "Total maternal deaths. The prior line chart shows that maternal mortality ratios have decreased,\nand we see in this stacked bar chart that total Sub-Saharan African maternal deaths remains the same\naround 200,000. While live births have increased in Sub-Saharan Africa, childbearing women in those\ncountries have continued to die at the same levels over the past 30 years. Total maternal deaths in\nEurope & Central Asia are so low compared to other regions that they almost appear invisible by 2015.
",
caption = "Source(s): The World Health Organization / The World Bank") +
xlab("Year") +
ylab("Total maternal deaths") +
coord_cartesian(clip = "off") +
special_theme +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.box.spacing = unit(2, "cm"))Rural and conflict-affected areas present barriers to critical health care for childbearing women. Below is a look at attendance rates of skilled health staff at the time of birth by country.
skilled_staff <- read.csv("~/Desktop/Data Visualization/DV Maternal Mortality/data/births-attended-by-health-staff-sdgs.csv", na.strings = c(""))
names(skilled_staff)[4] <- "pct_attended"
skilled_staff <- na.omit(skilled_staff)
skilled_staff.agg <- aggregate(Year ~ Code, skilled_staff, max)
skilled_staff.max <- merge(skilled_staff.agg, skilled_staff)
skilled_staff.max <- subset(skilled_staff.max, Year >= 2010)
#Citation for finding most recent year: https://nsaunders.wordpress.com/2013/02/13/basic-r-rows-that-contain-the-maximum-value-of-a-variable/
colnames(skilled_staff.max) <- paste("Staff", colnames(skilled_staff.max), sep = "_")
skilled_staff.max <- mutate(skilled_staff.max, Staff_pct_groups = case_when(Staff_pct_attended < 25 ~ 15, Staff_pct_attended >= 25 & Staff_pct_attended < 50 ~ 40, Staff_pct_attended >= 50 & Staff_pct_attended < 75 ~ 65, Staff_pct_attended >= 75 ~ 90))
counts <- skilled_staff.max %>% group_by(Staff_pct_groups) %>% tally()
world <- ne_countries(scale = "medium", returnclass = "sf")
world <- cbind(world, st_coordinates(st_centroid(world$geometry)))
merge_w_Staff <- left_join(world, skilled_staff.max, c("iso_a3" = "Staff_Code"))
df <- merge_w_Staff
ggplot() +
geom_sf(data = df %>% filter(continent != "Antarctica"), aes(fill = factor(Staff_pct_groups)), lwd = 0.1, color = "white") +
coord_sf(crs = st_crs(3467)) +
scale_fill_manual(values = c("#E3DD44", "#BD9840", "#974BBD", "#7102FA"),
na.value = "#dedede",
labels = c("< 25%", "25-50 %", "50-75 %", "75% >"),
name = "Attended by skilled health staff")+
geom_text_repel(data = filter(df, iso_a3 == "SSD"),
aes(x = X, y = Y, label = paste0(name, " (", Staff_pct_attended, "%)")),
nudge_x = 40,
nudge_y = -15,
family = "PT Mono",
size = 3) +
geom_text_repel(data = filter(df, iso_a3 == "TCD"),
aes(x = X, y = Y, label = paste0(name, "\n(", Staff_pct_attended, "%)")),
nudge_x = -30,
nudge_y = -20,
family = "PT Mono",
size = 3) +
coord_sf(clip = "off") +
labs(title = "Women in Africa, South Asia face issues of access to skilled care during birth",
subtitle = "Percent of births attended by skilled health staff; most recent survey year between 2010 and 2016. The Republic\nof Chad and the Republic of South Sudan have significantly lower percentages of births attended by skilled staff\n(less than 25%). Majority of countries have a minimum of 75% of births attended by skilled health staff, which\nare defined as doctors, nurses, midwives, or auxiliary midwives.",
caption = "Source(s): Our World in Data") +
special_theme +
theme(
axis.title = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()
) The Republic of Chad and South Sudan both report less than 25% births are attended by skilled health staff. For context, South Sudan has been in ongoing civil conflict, with different peace agreements being reached and then later overturned. The Republic of Chad is subject to recurrent natural disasters. Violent conflict and natural disasters both present as additional obstacles to childbearing women, and may inhibit attendance of skilled health care staff. Both variables may also obstruct obtainment of food and safe drinking water, as well as are cause for concern of bodily safety–all of which impact the health and wellness of childbearing women.
It is important to understand that maternal mortality is not singularly a human rights issue that developing countries battle with; the United States deals with increasing maternal mortality, as its MMR has been on the rise as early as the 1980s. Similar to issues that childbearing women globally deal with, childbearing women in the United States also face economic, racial and gender biases which inform participation and experience in the American health care system (through services provided directly from hospitals/doctors/medical staff, as well as through insurance coverage). Depending on locality, they may also be impacted by environmental disparities.
WHO_data <- read.csv("data/WHO_MMR-data-1990-2015 (1)/countryresults_all.csv")
# New table of mmr point estimates:
mmr_data <- filter(WHO_data,
indicator == "mmr",
estimate == "point estimate",
rounded == "FALSE")
WorldBank_data <- read_excel("data/WB_country_region_income.xlsx")
WorldBank_data <- WorldBank_data[,-c(3,6,7)]
# Merge WHO and WB data:
merged_WHO_WB_data <- sqldf("SELECT * from mmr_data
LEFT OUTER join WorldBank_data
ON mmr_data.iso = WorldBank_data.Code")
# Create subsets by income, then rank countries by maternal mortality ratio (mmr):
upper_income_countries <- filter(merged_WHO_WB_data, `Income group` == "High income")
ranked_mmr_of_upper_income <- arrange(upper_income_countries, year, value) %>%
group_by(year) %>%
mutate(rank = order(value))
# Find changes in rank from 1985 to 2015 for upper income countries:
change_in_rank_upper <- subset(ranked_mmr_of_upper_income, year %in% c(1985, 2015))
change_in_rank_upper <- change_in_rank_upper[,-c(4:11)]
change_in_rank_upper <- spread(change_in_rank_upper, year, rank)
change_in_rank_upper[3:4] <- lapply(change_in_rank_upper[3:4], as.numeric)
change_in_rank_upper <- mutate(change_in_rank_upper, rank_change = change_in_rank_upper$`1985` - change_in_rank_upper$`2015`)
# NB: United States (USA) fell by 21 spots, Poland (POL) gained by 27 spots
# Show only every 5 years:
show_years <- c(2015, 2010, 2005, 2000, 1995, 1990, 1985)
ranked_mmr_of_upper_income$Year_formatted <- as.character(ranked_mmr_of_upper_income$year)
ranked_mmr_of_upper_income <- subset(ranked_mmr_of_upper_income, year %in% show_years)
# Note rows for USA (down) and POL (up), so that they can be highlighted later in visualization:
ranked_mmr_of_upper_income <- mutate(ranked_mmr_of_upper_income,
highlight_country = case_when(iso == "USA" ~ 1,
iso == "POL" ~ 2,
TRUE ~ 0))
down_color <- "#7102FA"
up_color <- "#948E00"
df <- ranked_mmr_of_upper_income
ggplot(data = df, aes(x = year, y = rank, group = iso)) +
scale_y_reverse() +
## Other countries:
geom_line(data = df %>% filter(!iso %in% c("USA", "POL")), color = "grey", size = 0.25) +
geom_label(data = df %>% filter(!iso %in% c("USA", "POL")),
aes(label = rank),
size = 4,
label.padding = unit(0.05, "lines"),
label.size = 0.0,
color = "grey",
fill = background_color,
family = "PT Mono") +
geom_text(data = df %>% filter(!iso %in% c("USA", "POL") & year == 1985),
aes(label = iso) ,
nudge_x = -0.8,
vjust = 0.5,
hjust = 1,
size = 4,
color = "grey",
family = "PT Mono") +
geom_text(data = df %>% filter(!iso %in% c("USA", "POL") & year == 2015),
aes(label = iso) ,
nudge_x = 0.8,
vjust = 0.5,
hjust = 0,
size = 4,
color = "grey",
family = "PT Mono") +
## USA:
geom_line(data = df %>% filter(iso == "USA"), alpha = 1, color = down_color, size = 1) +
geom_label(data = df %>% filter(iso == "USA"),
aes(label = rank),
size = 4,
label.padding = unit(0.05, "lines"),
label.size = 0.0,
color = down_color,
fontface = "bold",
fill = background_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "USA" & year == 1985),
aes(label = iso),
nudge_x = -0.8,
vjust = 0.5,
hjust = 1,
fontface = "bold",
size = 4,
color = down_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "USA" & year == 2015),
aes(label = iso) ,
nudge_x = 0.8,
vjust = 0.5,
hjust = 0,
fontface = "bold",
size = 4,
color = down_color,
family = "PT Mono") +
## POL:
geom_line(data = df %>% filter(iso == "POL"), alpha = 1, color = up_color, size = 1) +
geom_label(data = df %>% filter(iso == "POL"),
aes(label = rank),
size = 4,
label.padding = unit(0.05, "lines"),
label.size = 0.0,
color = up_color,
fontface = "bold",
fill = background_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "POL" & year == 1985),
aes(label = iso) ,
nudge_x = -0.8,
vjust = 0.5,
hjust = 1,
fontface = "bold",
size = 4,
color = up_color,
family = "PT Mono") +
geom_text(data = df %>% filter(iso == "POL" & year == 2015),
aes(label = iso) ,
nudge_x = 0.8,
vjust = 0.5,
hjust = 0,
fontface = "bold",
size = 4,
color = up_color,
family = "PT Mono") +
scale_x_continuous(breaks = seq(1980, 2015, 5)) +
labs(title = "",
subtitle = "",
caption = "*as categorized by the World Bank's 2019 fiscal year estimates \nSource(s): The World Health Organization / The World Bank") +
xlab("Year") +
ylab("Country ranking") +
coord_cartesian(xlim = c(1985,2015), ylim = c(1,52), clip = "off") +
annotate("text", x = 1985, y = -6.5, hjust = 0, parse=T, label=expression(bold("United States") * phantom(bold(" falls in maternal health; ")) * phantom(bold("Poland")) * phantom(bold(" improves the most"))), color = down_color, size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -6.5, hjust = 0, parse=T, label=expression(phantom(bold("United States")) * bold(" falls in maternal health; ") * phantom(bold("Poland")) * phantom(bold(" improves the most"))), color = "black", size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -6.5, hjust = 0, parse=T, label=expression(phantom(bold("United States")) * phantom(bold(" falls in maternal health; ")) * bold("Poland") * phantom(bold(" improves the most"))), color = up_color, size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -6.5, hjust = 0, parse=T, label=expression(phantom(bold("United States")) * phantom(bold(" falls in maternal health; ")) * phantom(bold("Poland")) * bold(" improves the most")), color = "black", size = 7, family = "Raleway") +
annotate("text", x = 1985, y = -4, hjust = 0, label = "Ranking of maternal mortality ratios of high-income* countries. From 1985 to 2015, the United States\nhad the greatest drop in maternal mortality health rankings among high-income countries. The U.S.\nfell by 21 spots, where as Poland increased by 27 spots.", size = 4, family = "PT Mono", lineheight = 0.8) +
annotate("text", x=2012.5, y=47, label="HIGH\nmortality\nratio", hjust = 0.5, size = 4, color = down_color, fontface = "bold.italic", family = "PT Mono") +
annotate("text", x=2012.5, y=6, label="LOW\nmortality\nratio", hjust = 0.5, size = 4, color = up_color, fontface = "bold.italic", family = "PT Mono") +
special_theme +
theme(
axis.text.y = element_blank(),
legend.position = "none",
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()
)# change text color:
# - https://stackoverflow.com/questions/49735290/ggplot2-color-individual-words-in-title
#Visualization idea adapted from Emma Peterson (https://emmacooperpeterson.github.io/human_trafficking_viz/)The United States has seen a large decline in its ranking against other high-income countries. Leading the charge in understanding why this is, large governmental organizations (such as the Center for Disease Control and National Institutes of Health) have begun collaborative data collection and analysis efforts across states. Top priority is identify the pregnancy-related causes of maternal deaths and scoping the shape and spread of maternal mortality.
Taking a different approach to maternal mortality, Poland began by looking seriously at the gender biases which riddled their health care system. Poland attributes some of its success in greatly reducing MMR to its “Childbirth with Dignity” human and women’s rights campaign, which started over two decades ago, resulting in its Ministry of Health promulgating the Perinatal and Postnatal Care Standards in 2011.
In 2018, the MMR for the United States was the highest it has been in decades: 20.7 deaths per 100,000 live births. Looking at the spread of maternal mortality throughout the nation may assist in the quick identification of states where intervention is most needed, as well as bring into focus those states from which best practices to reduce MMR may be learned.
shape <- read_sf(dsn = "~/Desktop/Data Visualization/DV Maternal Mortality/data/states_21basic/", layer = "states")
AHR_2018data <- read.csv("data/2018-HWC (4).csv")
AHR_2018allstates <- filter(AHR_2018data, AHR_2018data$Measure.Name == "Maternal Mortality")
AHR_2018allstates <- filter(AHR_2018allstates, State.Name != "United States") #remove "US" observation
AHR_2018allstates <- mutate(AHR_2018allstates, quantile_rank = ntile(AHR_2018allstates$Value, 5))
AHR_2018allstates$State.Name <- as.character(AHR_2018allstates$State.Name)
merged_data <- left_join(shape, AHR_2018allstates, c("STATE_NAME"= "State.Name"))
US_map <- ggplot() +
geom_sf(data = merged_data, aes(fill = factor(quantile_rank))) +
coord_sf(crs = st_crs(2163), xlim = c(-1900000, 2400000), ylim = c(-2000000, 710000)) +
scale_fill_manual(values = rev(c("#E3DD44", "#C6A671", "#AA6F9F", "#8D38CC", "#7102FA")), na.value = "#dedede") +
special_theme +
theme(
axis.title = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
legend.position = "none",
panel.background = element_rect(fill = "transparent"),
plot.background = element_rect(fill = "transparent", color = "transparent"),
plot.margin = unit(c(0,0,0,0),"cm"),
panel.grid.major = element_line(colour = "transparent")
)
stateabbr2 = data.frame(name=c("District of Columbia", "United States"), abbr=c("DC", "USA"))
stateabbr = data.frame(name=state.name, abbr=state.abb)
stateNabb <- rbind(stateabbr, stateabbr2)
US_mmr <- merge(AHR_2018allstates, stateNabb, by.x = c("State.Name"), by.y = c("name"))
US_mmr <- filter(US_mmr, !abbr %in% c("VT", "AK"))
df <- US_mmr
# df <- subset(US_mmr, abbr != c("VT, AK"))
ggplot(df, aes(x = reorder(abbr, Value), y = Value, fill = factor(quantile_rank))) +
geom_bar(stat = "identity") +
scale_fill_manual(values = rev(c("#E3DD44", "#C6A671", "#AA6F9F", "#8D38CC", "#7102FA")), na.value = "#dedede", labels = c("4.5-13.7", "14.0-16.8", "16.8-20.6", "21.2-26.5", "28.0-46.2", "NA"), name = "Deaths/100,000 live births") +
geom_text(data = df %>% filter(quantile_rank == 1), aes(label = abbr), angle = 90, color = "white", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 2), aes(label = abbr), angle = 90, color = "white", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 3), aes(label = abbr), angle = 90, color = "white", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 4), aes(label = abbr), angle = 90, color = "black", nudge_y = -1.5, family = "PT Mono") +
geom_text(data = df %>% filter(quantile_rank == 5), aes(label = abbr), angle = 90, color = "black", nudge_y = -1.5, family = "PT Mono") +
labs(title = "States to further investigate: California and Georgia",
subtitle = "2018 maternal deaths per 100,000 live births (inclusive of deaths that occur during gestation and up to\n42 days after termination of pregnancy). Georgia shows the highest MMR at 46.2 deaths per 100,000 live\nbirths. Only a few states (California, Massachusetts, and Nevada) have mortality ratios in the\nsingle digits.",
caption = "Note: No data on VT or AK.\nSource(s): America's Health Rankings") +
xlab("States") +
ylab("Deaths per 100,000 live births") +
special_theme +
theme(
axis.text.x = element_blank(),
legend.position = "bottom",
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()
) +
annotation_custom(
grob = ggplotGrob(US_map),
xmin = 0,
xmax = 38,
ymin = 22,
ymax = 50
)The prior visualization presented MMR across states. On its face, California is doing very well with the lowest MMR of 4.5 deaths/100,000 live births; however, it is necessary to take into account the population sizes that are affected state-by-state. California has a large population of women of childbearing age (approximately 8 million), and subsequently still has a large number of total deaths. For policy makers, it is critical to distinguish the differences between ratios and total deaths when examining a state for best practices. In the case of California, it is evident that they still have a significant amount of work to do in reducing overall maternal deaths.
## AHR change in mmr by state
AHR_2018 <- read.csv("data/2018-HWC (4).csv")
AHR_2018 <- filter(AHR_2018, AHR_2018$Measure.Name == "Maternal Mortality")
names(AHR_2018)[names(AHR_2018) == 'Value'] <- 'Value_2018'
AHR_2018 <- subset(AHR_2018, select = c("State.Name", "Value_2018"))
AHR_2016 <- read.csv("data/2016-HWC.csv")
AHR_2016 <- filter(AHR_2016, AHR_2016$Measure.Name == "Maternal Mortality")
names(AHR_2016)[names(AHR_2016) == 'Value'] <- 'Value_2016'
AHR_2016 <- subset(AHR_2016, select = c("State.Name", "Value_2016"))
merge_data <- left_join(AHR_2016, AHR_2018, c("State.Name"="State.Name"))
merge_data <- mutate(merge_data, change = Value_2018 - Value_2016)
## ACS childbearing pop
ACS <- read.csv("data/ACS_17_5YR_S0101_with_ann.csv")
ACS <- subset(ACS, select = c("GEO.display.label", "HC05_EST_VC01", "HC05_EST_VC27"))
names(ACS)[names(ACS) == 'HC05_EST_VC27'] <- 'FemalePop_15to44'
names(ACS)[names(ACS) == 'HC05_EST_VC01'] <- 'FemalePop_total'
names(ACS)[names(ACS) == 'GEO.display.label'] <- 'State.Name'
ACS <- subset(ACS, State.Name != "Geography")
ACS <- subset(ACS, State.Name != "Puerto Rico")
merge_data <- left_join(merge_data, ACS, c("State.Name"="State.Name"))
merge_data$FemalePop_15to44 <- as.numeric(as.character(merge_data$FemalePop_15to44))
## state abbreviations
stateabbr2 = data.frame(name=c("District of Columbia", "United States"), abbr=c("DC", "USA"))
stateabbr = data.frame(name=state.name, abbr=state.abb)
stateNabb <- rbind(stateabbr, stateabbr2)
merge_data <- merge(merge_data, stateNabb, by.x = c("State.Name"), by.y = c("name"))
merge_data <- mutate(merge_data, color = case_when(change <= 0 ~ -1, change > 0 ~ 1))
merge_data <- subset(merge_data, State.Name != "United States")
merge_data <- subset(merge_data, State.Name != "Alaska")
merge_data <- subset(merge_data, State.Name != "Vermont")
df <- merge_data
down_color <- "#7102FA"
up_color <- "#948E00"
ggplot(df, aes(y = reorder(abbr, change), x = change, color = as.factor(color))) +
geom_point(aes(size = FemalePop_15to44), alpha = 0.5) +
# DECREASED:
geom_text(data = df %>% filter(change <= 0 & !(abbr %in% c("CA","DC", "HI", "KS", "KY", "NY", "MT", "UT", "PA"))),
aes(label = abbr),
color = "black",
hjust = "right",
family = "PT Mono",
nudge_x = -0.15,
size = 2.75) +
geom_text_repel(data = df %>% filter(abbr == "UT"),
aes(label = abbr),
color = "black",
hjust = "right",
family = "PT Mono",
nudge_x = -0.3,
nudge_y = 1.5,
size = 2.75) +
geom_text(data = df %>% filter(abbr %in% c("KS", "HI", "KY")),
aes(label = abbr),
color = "black",
hjust = "left",
family = "PT Mono",
nudge_x = 0.15,
size = 2.75) +
geom_text_repel(data = df %>% filter(abbr %in% c("NY", "MT", "PA")),
aes(label = abbr),
color = "black",
hjust = "left",
family = "PT Mono",
nudge_x = 0.6,
size = 2.75) +
geom_text_repel(data = df %>% filter(abbr == "CA"),
aes(label = "CA:\n-1.4 deaths,\n8M women,\n(2018 mmr = 4.5)"),
color = "black",
hjust = "center",
family = "PT Mono",
size = 2.75,
nudge_x = 0.35,
nudge_y = -6) +
# INCREASED:
geom_text(data = df %>% filter(change > 0 & !(abbr %in% c("TX", "LA", "NM", "IA", "NC", "IN"))),
aes(label = abbr),
color = "black",
hjust = "left",
family = "PT Mono",
nudge_x = 0.25,
size = 2.75) +
geom_text(data = df %>% filter(abbr %in% c("NC")),
aes(label = abbr),
color = "black",
hjust = "right",
family = "PT Mono",
nudge_x = -0.15,
nudge_y = 1,
size = 2.75) +
geom_text(data = df %>% filter(abbr %in% c("NM", "IA", "IN")),
aes(label = abbr),
color = "black",
hjust = "right",
family = "PT Mono",
nudge_x = -0.25,
size = 2.75) +
geom_text_repel(data = df %>% filter(abbr == "TX"),
aes(label = "TX:\n+2.7 deaths,\n5.7M women,\n(2018 mmr = 34.2)"),
color = "black",
hjust = "left",
family = "PT Mono",
size = 2.75,
nudge_x = .4,
nudge_y = -3) +
geom_text_repel(data = df %>% filter(abbr == "LA"),
aes(label = "LA: +9.8 deaths,\n0.9M women,\n(2018 mmr = 44.8)"),
color = "black",
vjust = "top",
family = "PT Mono",
size = 2.75,
nudge_y = -3,
nudge_x = -0.9) +
geom_text_repel(data = df %>% filter(abbr == "DC"),
aes(label = "DC: -4.6 deaths,\n180K women,\n(2018 mmr = 36.1)"),
color = "black",
vjust = "top",
family = "PT Mono",
size = 2.75,
nudge_y = 10,
nudge_x = 0.6) +
scale_color_manual(values = c("#948E00", "#7102FA"), guide = "none") +
scale_x_continuous(position = "top") +
scale_size_continuous(range = c(1,10),
breaks = c(2000000, 4000000, 6000000, 8000000),
labels = c("2M", "4M", "6M", "8M"),
name = "Population of women\nAges 15-44") +
labs(title = "In more populous states, changes in maternal mortality ratio (MMR) impacts a larger\nnumber of women in childbearing ages",
subtitle = "2016 to 2018: Change in maternal deaths per 100,000 live births, against population of women of childbearing\nage (15 to 44 years). Population size matters when measuring the magnitude of deaths for women of\nchildbearing age.",
caption = "Note: No MMR data on VT or AK.\nSource(s): America's Health Rankings / American Community Survey") +
xlab("Change in MMR (deaths/100,000 live births) against female population in childbearing ages") +
annotate("text", y = "LA", x = 0.2, hjust = "left", family = "PT Mono", size = 3, vjust = "top", color = "#7102FA", label = "Increase in\nmortality ratio") +
annotate("text", y = "LA", x = -0.2, hjust = "right", family = "PT Mono", size = 3, vjust = "top", color = "#948E00", label = "Decrease in\nmortality ratio") +
geom_vline(xintercept = 0) +
special_theme +
theme(
axis.text.y = element_blank(),
axis.title.y = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank()
)Racial biases are implicit and pervasive in the American health care system. The presence of biases leads to inadequate and unequal health care delivered to Black women. Key questions which interested parties try to answer when identifying the intersection issues of gender and race as they relate to maternal deaths are: (1) what caused the death, (2) was it pregnancy-related, (3) was death preventable, (4) what were the critical factors which contributed to these deaths, (5) what are the recommendations to decrease preventable deaths?
AHR_data <- read.csv("data/2018-HWC (4).csv")
keep <- c("Maternal Mortality - AIAN","Maternal Mortality - Asian/Pacific Islander","Maternal Mortality - Black","Maternal Mortality - Hispanic","Maternal Mortality - White")
AHR_mmr_by_race <- filter(AHR_data, AHR_data$Measure.Name %in% keep)
#If you want region of the country:
northeast <- c("Connecticut", "Maine", "Massachusetts", "New Hampshire", "Rhode Island", "Vermont", "New Jersey", "New York", "Pennsylvania")
midwest <- c("Illinois","Indiana","Michigan","Ohio","Wisconsin","Iowa","Kansas","Minnesota","Missouri","Nebraska","North Dakota","South Dakota")
south <- c("Delaware","District of Columbia","Florida","Georgia","Maryland","North Carolina","South Carolina","Virginia","West Virginia","Alabama","Kentucky","Mississippi","Tennessee","Arkansas","Louisiana","Oklahoma","Texas")
west <- c("Arizona","Colorado","Idaho","Montana","Nevada","New Mexico","Utah","Wyoming","Alaska","California","Hawaii","Oregon","Washington")
AHR_mmr_by_race <- mutate(AHR_mmr_by_race, Region = case_when(State.Name %in% northeast ~ "Northeast", State.Name %in% midwest ~ "Midwest", State.Name %in% south ~ "South", State.Name %in% west ~ "West"))
AHR_mmr_by_race <- drop_na(AHR_mmr_by_race, c("Value"))
AHR_mmr_by_race <- filter(AHR_mmr_by_race, State.Name != "United States") #remove "US" observation
AHR_mmr_by_race <- mutate(AHR_mmr_by_race,
Race =
case_when(Measure.Name ==
"Maternal Mortality - AIAN" ~ "AIAN",
Measure.Name ==
"Maternal Mortality - Asian/Pacific Islander" ~
"Asian/Pacific Islander women",
Measure.Name ==
"Maternal Mortality - Black" ~
"Black women",
Measure.Name ==
"Maternal Mortality - Hispanic" ~
"Hispanic women",
Measure.Name ==
"Maternal Mortality - White" ~ "White women"))
# drop AIAN because only one observation
AHR_mmr_by_race <- filter(AHR_mmr_by_race, Race != "AIAN")
# if labeling states
stateabbr2 = data.frame(name=c("District of Columbia", "United States"), abbr=c("DC", "USA"))
stateabbr = data.frame(name=state.name, abbr=state.abb)
stateNabb <- rbind(stateabbr, stateabbr2)
AHR_race <- merge(AHR_mmr_by_race, stateNabb, by.x = c("State.Name"), by.y = c("name"))
df <- AHR_race
ggplot(df, aes(x = Race, y = Value, colour = Race)) +
geom_point(size = 5, alpha = 0.7) +
scale_colour_manual(values = c("#D4626F", "#E3DD44", "#948E00","#7102FA")) +
scale_x_discrete(labels = function(x) str_wrap(x, width = 10)) +
geom_point(size = 1.5, color = "black") +
## ASIAN/PACIFIC ISLANDER
geom_text(data = df %>% filter(Race == "Asian/Pacific Islander women" & abbr == "CA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
geom_text_repel(data = df %>% filter(Race == "Asian/Pacific Islander women" & abbr == "IL"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, nudge_y = -1, family = "PT Mono") +
## BLACK
geom_text(data = df %>% filter(Race == "Black women" & abbr == "NJ"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
geom_text(data = df %>% filter(Race == "Black women" & abbr == "CA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
## LATINA
geom_text(data = df %>% filter(Race == "Hispanic women" & abbr == "CA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
geom_text(data = df %>% filter(Race == "Hispanic women" & abbr == "UT"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
## WHITE
geom_text_repel(data = df %>% filter(Race == "White women" & abbr == "MA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, nudge_y = -1, family = "PT Mono") +
geom_text(data = df %>% filter(Race == "White women" & abbr == "GA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = 0.15, family = "PT Mono") +
geom_text_repel(data = df %>% filter(Race == "White women" & abbr == "CA"), aes(label = abbr), color = "black", vjust = "center", nudge_x = -.15, nudge_y = 1, family = "PT Mono") +
geom_hline(yintercept = 20.7, linetype = "dashed", color = "#4A4A4A") +
labs(title = "Black women in the U.S. face higher maternal mortality",
subtitle = "Maternal deaths per 100,000 live births, in 2018. Black women in New Jersey suffer at the highest ratio\nof maternal mortality of 102.3 deaths per 100,000 live births. California is the only state in which\nBlack women have maternal mortality ratios less than the national ratio.",
caption = "Note: American Indian/Alaskan Native women not visualized due to minimal data. No data on VT or AK.\nSource(s): America's Health Rankings") +
ylab("Deaths per 100,000 live births") +
coord_cartesian(clip = "off") +
annotate("text", x = 5, y = 18, label = "2018:\nU.S. maternal\nmortality ratio was\n20.7 deaths per\n100,000 live births", size = 3, hjust = "right", vjust = "top", family = "PT Mono") +
annotate("point", x = 4.37, y = 95, size = 5, alpha = 0.7, color = "grey") +
annotate("point", x = 4.37, y = 95, size = 1.5, color = "black") +
annotate("text", x = 5, y = 95, hjust = "right", label = " = one state", family = "PT Mono") +
special_theme +
theme(
legend.position = "none",
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank()
)The Building U.S. Capacity to Review and Prevent Maternal Deaths Project Team (a collaboration between the CDC, CDC Foundation, and the Association of Maternal and Child Health Programs) estimates that Black women are dying at a staggering rate of 3x to 4x more often than White women, of pregnancy-related causes. As outlined in a February 15, 2019, seminar at Harris School of Public Policy given by Andrea Palmer (Chief of the Division of Maternal, Child and Family Health Services of the Illinois Department of Public Health), severe racial disparities are resultant of (1) health care providers having racial bias against Black mothers, and (2) systemic institutional racism, and (3) lack of medical care coverage by insurances during critical times of pregnancy and postpartum. Looking at the state of Illinois, this gap between Black and White mothers is even higher, where Black mothers are 6.5x more likely to die that White mothers of pregnancy-related causes. Often, these pregnancy-related deaths are preventable (in Illinois, 72% of pregnancy-related deaths were found to be preventable).
NIH_disparity_ratios <- read_excel("data/NIH_disparity_ratios.xlsx")
facet_text <- data.frame(type = c("prevalence", "case fatality", "prevalence"),
label = c("Significant\ndifference\nby race", "Insignificant\ndifference\nby race", ""),
x = c(6, 0.3, 3),
y = c(3.15, 1.1, 0.9))
facet_segment1 <- data.frame(type = c("case fatality", "case fatality","case fatality"),
x_start = c(0, 0.1, 0),
x_end = c(0.1, 0.1, 0.1),
y_start = c(0.8, 0.8, 1.6),
y_end = c(0.8, 1.6, 1.6))
facet_segment2 <- data.frame(type = c("case fatality", "case fatality","case fatality"),
x_start = c(0.1, 0.1, 0.1),
x_end = c(0.2, 0.1, 0.2),
y_start = c(2.4, 2.4, 3.9),
y_end = c(2.4, 3.9, 3.9))
df <- NIH_disparity_ratios
df$type <- factor(df$type, levels=c("prevalence", "case fatality", "PRMR"))
type.labs <- c("Prevalence of\ncomplication", "Case fatality\nfrom complication", "Pregnancy-related\nMortality Ratio\n(prevalence x case\nfatality)")
names(type.labs) <- c("prevalence", "case fatality", "PRMR")
ggplot(df, aes(y = ratio, x = condition)) +
geom_point(aes(color = condition), size = 3, alpha = 1) +
facet_grid(. ~ type, labeller = labeller(type = type.labs)) +
scale_color_manual(values = c("#7102FA", "#CC149B", "#E3DD44", "#E48023", "#357797"),
name = "Pregnancy\ncomplications:",
labels = function(x) str_wrap(x, width = 10)) +
scale_y_continuous(breaks = c(1,2,3,4), labels = c("1:1\nBlack:White\nwomen", "2:1", "3:1", "4:1")) +
geom_hline(yintercept = 1, linetype = "dashed", color = "black") +
geom_text(aes(x = x, y = y, label = label, group = NULL),
data = facet_text,
family = "PT Mono",
size = c(3, 3, 2.5),
hjust = c(1, 0, 0.5),
vjust = c(0, 0, 0),
nudge_y = c(-0.05, 0, 0)) +
geom_segment(aes(x = x_start, y = y_start, xend = x_end, yend = y_end), data = facet_segment1) +
geom_segment(aes(x = x_start, y = y_start, xend = x_end, yend = y_end), data = facet_segment2) +
labs(title = "Pregnancy complications are similarly prevalent among White and Black women,\nyet Black mothers are more likely to die",
subtitle = "Comparison of prevalence rates, case fatality rates, and pregnancy-related mortality ratios of\n5 pregnancy complications, between Black and White women. A national case study found that Black\nwomen were 2x to 3x more likely to die from pregnancy-related complications than White women.",
caption = "Source(s): Tucker et alia") +
ylab("Black women : White women") +
coord_cartesian(clip = "off") +
special_theme +
theme(legend.position = "right",
legend.key.size = unit(0.9, 'cm'),
axis.text.x = element_blank(),
axis.title.x = element_blank(),
panel.grid.major.x = element_blank(),
strip.background = element_rect(fill = "#f7f7f7"),
strip.text = element_text(size = 10, family = "PT Mono"))Exploratory analysis at both the global level, and a more in-depth look at the United States, highlights the meaningful differences between looking at mortality ratios and total deaths. Collaborative, interdisciplinary work between policy makers, health care providers, social organizers, and social workers is necessary to identify prevention methods to protect mothers and provide comprehensive health care. To bring to fruition a goal of zero preventable pregnancy-related deaths will require better data surveillance and accountability in order to change systemic biases at the center of the maternal mortality epidemic.